home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
pas_0593.zip
/
SORT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-05-30
|
4KB
|
116 lines
{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg : 492 of 527
From : Alexander Christov 2:341/34.0 14 May 93 12:42
To : All
Subj : Sorting routines (1/3)
────────────────────────────────────────────────────────────────────────────────
Hi All!
I don't know if code like this has been posted on this echo, but anyway here it
goes. It implements three different versions of Qsort which so far if the
fastest sorting algorithm known. However, it is not adequate for sorting file
records. I've tested the routines and have worked with them for quite a while,
but don't trust me 8-) Murphy never sleeps 8-)}
UNIT SORT;
{─────────────────────────────────────────────────────────────────────────}
{ Purpose : Unit that implements a generic QSort(), similar to }
{ the one in the standard C library. }
{ Author : Alexander Christov }
{ Notes : Very instructive on the use of pointers in TP. }
{ }
{ Use freely. }
{ }
{─────────────────────────────────────────────────────────────────────────}
INTERFACE
TYPE CmpFunc=Function(El1,El2:Pointer):Boolean;
Procedure QSort(Base:Pointer;Elements,Size:WORD;GT:CmpFunc);
{ Base - Pointer to the first element
Elements - Number of elements
Size - Size of an element in bytes. Use SizeOf() if in doubt
GT - A function of type CmpFunc that compares the elements pointed
to by the first and the second arguments and returns TRUE
if the first is greater than the second. GT = Greater Than
8-)
}
{ Some commonly used CmpFunc }
Function bGT(El1,El2:Pointer):Boolean; { Compares ^BYTE }
Function wGT(El1,El2:Pointer):Boolean; { Compares ^WORD }
Function lGT(El1,El2:Pointer):Boolean; { Compares ^LONGINT }
Function rGT(El1,El2:Pointer):Boolean; { Compares ^REAL }
IMPLEMENTATION
{$F+}
TYPE Dummy=ARRAY[0..0] OF BYTE;
pDummy=^Dummy;
{ Recursive implementation }
Procedure _Sort(Base:Pointer;L,R,Size:WORD;GT:CmpFunc);
VAR I,J:Integer;
VAR X:Pointer;
Procedure SwapElements(El1,El2:Word);
VAR Tmp:Pointer;
BEGIN
GetMem(Tmp,Size);
Move(pDummy(Base)^[El1*Size],Tmp^,Size);
Move(pDummy(Base)^[El2*Size],pDummy(Base)^[El1*Size],Size);
Move(Tmp^,pDummy(Base)^[El2*Size],Size);
FreeMem(Tmp,Size);
END;
BEGIN
I:=L;
J:=R;
GetMem(X,Size);
Move(pDummy(Base)^[((L+R) div 2)*Size],X^,Size);
REPEAT
While GT(X,@pDummy(Base)^[I*Size]) DO INC(I);
While GT(@pDummy(Base)^[J*Size],X) DO DEC(J);
IF I<=J THEN BEGIN
IF I<>J THEN SwapElements(I,J);
INC(I);
DEC(J);
END;
UNTIL I>J;
FreeMem(X,Size);
IF L<J THEN _Sort(Base,L,J,Size,GT);
IF I<R THEN _Sort(Base,I,R,Size,GT);
END;
Procedure QSort(Base:Pointer;Elements,Size:WORD;GT:CmpFunc);
BEGIN
_Sort(Base,0,Elements-1,Size,GT);
END;
Function bGT(El1,El2:Pointer):Boolean;
TYPE pByte=^Byte;
BEGIN
bGt:=(pByte(El1)^>pByte(El2)^);
END;
Function wGT(El1,El2:Pointer):Boolean;
TYPE pWord=^Word;
BEGIN
wGt:=(pWord(El1)^>pWord(El2)^);
END;
Function lGT(El1,El2:Pointer):Boolean;
TYPE pLongint=^Longint;
BEGIN
lGt:=(pLongInt(El1)^>pLongInt(El2)^);
END;
Function rGT(El1,El2:Pointer):Boolean;
TYPE pReal=^Real;
BEGIN
rGt:=(pReal(El1)^>pReal(El2)^);
END;
END.